home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / newsgrp / group01b.txt / 000057_icon-group-sender_Mon Mar 12 08:26:49 2001.msg < prev    next >
Internet Message Format  |  2002-01-03  |  3KB
  1. Return-Path: <icon-group-sender>
  2. Received: (from root@localhost)
  3.     by baskerville.CS.Arizona.EDU (8.11.1/8.11.1) id f2CFQkM11692
  4.     for icon-group-addresses; Mon, 12 Mar 2001 08:26:46 -0700 (MST)
  5. Message-Id: <200103121526.f2CFQkM11692@baskerville.CS.Arizona.EDU>
  6. From: jwormsley@debitek.com (Jeffrey A. Wormsley)
  7. X-Newsgroups: comp.lang.apl,comp.lang.forth,comp.lang.icon,comp.lang.lisp,comp.lang.mumps,comp.lang.scheme,comp.lang.smalltalk
  8. Subject: Re: New Scientist Puzzle
  9. Date: Mon, 12 Mar 2001 15:03:36 -0000
  10. User-Agent: Xnews/03.09.22
  11. Cache-Post-Path: real.nextlec.net!unknown@102-1.du-92.mt0.cha1.dialup.nextlec.net
  12. X-Cache: nntpcache 2.3.3 (see http://www.nntpcache.org/)
  13. X-Complaints-To: newsabuse@supernews.com
  14. To: icon-group@cs.arizona.edu
  15. Errors-To: icon-group-errors@cs.arizona.edu
  16. Status: RO
  17. Content-Length: 1977
  18.  
  19. Can't help be throw a very verbose and fly right at it Delphi solution 
  20. in...  Certaily isn't 5 lines like the K solution, but then I can't read 
  21. the K solution ;^).
  22.  
  23. unit Main;
  24.  
  25. interface
  26.  
  27. uses
  28.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  29.   StdCtrls;
  30.  
  31. type
  32.   TForm1 = class(TForm)
  33.     Memo1: TMemo;
  34.     Button1: TButton;
  35.     procedure Button1Click(Sender: TObject);
  36.   private
  37.     { Private declarations }
  38.     Function  Match(I,J : Integer): Boolean;
  39.     Procedure FindMatches;
  40.   public
  41.     { Public declarations }
  42.   end;
  43.  
  44. var
  45.   Form1: TForm1;
  46.  
  47. implementation
  48.  
  49. {$R *.DFM}
  50.  
  51. Function TForm1.Match(I,J : Integer): Boolean;
  52. Var S : String;
  53.     K, L : Byte;
  54. Begin
  55.  Result := False;                              // Assume no match
  56.  S := IntToStr(Sqr(I)) + IntToStr(Sqr(J));     // Build string
  57.  If (S[3] <> S[6]) or (S[5] <> S[8]) then      // Check the E's and N's
  58.   Exit;                                        // Exit if not matched
  59.  S := S[1] + S[2] + S[3] + S[4] + S[5] + S[7]; // Remove dup E's and N's
  60.  For K := 1 to Length(S) - 1 Do                // Scan for dups
  61.   For L := K + 1 to Length(S) Do
  62.    If S[K] = S[L] then                         // If dup found
  63.     Exit;                                      // Exit
  64.  Result := True;                               // Good match if this far
  65. End;
  66.  
  67. Procedure TForm1.FindMatches;
  68. Var I, J, A, B : Byte;
  69. Begin
  70.  For I := 34 to 89 do
  71.   Begin
  72.    A := I div 10; B := I mod 10;               // Get digits
  73.    If A <> B then                              // Can't work if equal
  74.     Begin
  75.      J := A + (B * 10);                        // Transpose digits
  76.      If Match(I,J) then                        // Check for match
  77.       Memo1.Lines.Add( 'VIER = ' + IntToStr(Sqr(I)) +
  78.                       ' NEUN = ' + IntToStr(Sqr(J)) +
  79.                       ' (' + IntToStr(I) + ',' + IntToStr(J) + ')');
  80.     End;
  81.   End;
  82. End;
  83.  
  84. procedure TForm1.Button1Click(Sender: TObject);
  85. begin
  86.  FindMatches;
  87. end;
  88.  
  89. end.
  90.  
  91. Jeff.
  92.